home *** CD-ROM | disk | FTP | other *** search
/ Crack It! / Crack It!.iso / CONTENT / DISKEDIT / DIR.PAS < prev    next >
Pascal/Delphi Source File  |  1996-09-10  |  9KB  |  328 lines

  1. {
  2.   ***
  3.  
  4.   DIR.PAS - an object-oriented file selection facility
  5.   (C)Copyright Gerard Paul Java 1996
  6.  
  7. }
  8.  
  9. unit Dir;
  10.  
  11. interface
  12. uses Dos;
  13.  
  14. type
  15.   FileNameStr = string[13];
  16.  
  17.   DirListType = ^DirEntry;
  18.   DirEntry = record
  19.                Name: FileNameStr;
  20.                Prev,Next: DirListType;
  21.              end;
  22.  
  23.   DirObject = object
  24.                 DirName: DirStr;
  25.                 Mask: FileNameStr;
  26.                 DirList: DirListType;
  27.                 DirError: boolean;
  28.                 procedure Init;
  29.                 procedure ReadIn(PathName: PathStr);
  30.                 procedure Select(X,Y: byte;
  31.                                  var FileName: FileNameStr;var Signal: boolean);
  32.                 procedure Sort(ListToSort: DirListType);
  33.                 procedure Clear;
  34.               end;
  35.  
  36. implementation
  37. uses Crt,ScreenRt,SysRt,MenuRt,Error;
  38.  
  39. procedure DirObject.Init;
  40. begin
  41.   DirList := nil;
  42.   DirError := False;
  43. end;
  44.  
  45. procedure DirObject.ReadIn;
  46. var
  47.   tNode: DirListType;
  48.   LastNode: DirListType;
  49.   sRec: SearchRec;
  50.   FileName: NameStr;
  51.   FileExt: ExtStr;
  52.  
  53.   Dirs: DirListType;
  54.   LastDir: DirListType;
  55.  
  56. begin
  57.   Dirs := nil;
  58.  
  59.   FSplit(PathName,DirName,FileName,FileExt);
  60.  
  61.   Mask := FileName+FileExt;
  62.  
  63.   { first build a list of all subdirectories }
  64.  
  65.   FindFirst(DirName+'*.*',Directory,sRec);
  66.   while DosError = 0 do
  67.     begin
  68.       if ((sRec.Attr and Directory) <> 0) and (sRec.Name <> '.')then
  69.         begin
  70.           New(tNode);
  71.           tNode^.Name := sRec.Name+'\';
  72.  
  73.           if Dirs = nil then
  74.             begin
  75.               tNode^.Prev := nil;
  76.               Dirs := tNode;
  77.             end
  78.           else
  79.             begin
  80.               tNode^.Prev := LastDir;
  81.               LastDir^.Next := tNode;
  82.             end;
  83.  
  84.           LastDir := tNode;
  85.           tNode^.Next := nil;
  86.         end;
  87.       FindNext(sRec);
  88.     end;
  89.  
  90.   FindFirst(PathName,Archive+ReadOnly,sRec);
  91.  
  92.   while DosError = 0 do
  93.     begin
  94.       New(tNode);
  95.  
  96.       tNode^.Name := sRec.Name;
  97.  
  98.       if DirList = nil then
  99.         begin
  100.           tNode^.Prev := nil;
  101.           DirList := tNode;
  102.         end
  103.       else
  104.         begin
  105.           LastNode^.Next := tNode;
  106.           tNode^.Prev := LastNode;
  107.         end;
  108.  
  109.       LastNode := tNode;
  110.       tNode^.Next := nil;
  111.  
  112.       FindNext(sRec);
  113.     end;
  114.  
  115.   if (DosError <> 0) and (DosError <> 18) then
  116.     DirError := True;
  117.  
  118.   Sort(DirList);
  119.   Sort(Dirs);
  120.  
  121.   if Dirs <> nil then
  122.     begin
  123.       LastDir^.Next := DirList;
  124.       DirList^.Prev := LastDir;
  125.       DirList := Dirs;
  126.     end;
  127.  
  128. end;
  129.  
  130. procedure DirObject.Select;
  131. var
  132.   tNode,ScrollNode: DirListType;
  133.   Row: byte;
  134.   Keystroke: char;
  135.   TerminateLoop: boolean;
  136.   Ctr: byte;
  137.  
  138. begin
  139.   if DirError then
  140.     begin
  141.       ErrBox('Unable to read directory','Press a key to continue',Instruct);
  142.       WaitForKeyPress;
  143.       Signal := True;
  144.     end
  145.   else if DirList = nil then
  146.     begin
  147.       ErrBox('No files found','Press a key to continue',Instruct);
  148.       WaitForKeyPress;
  149.       Signal := True;
  150.     end
  151.   else
  152.     begin
  153.       tNode := DirList;
  154.       Row := 1;
  155.  
  156.       TextAttr := BoxAttr;
  157.       DrawBox(X,Y,X+17,Y+10,DoubleLine);Window(X+1,Y+1,X+16,Y+9);
  158.  
  159.       Row := 0;
  160.       TextAttr := OptionNormTextAttr;
  161.  
  162.       repeat
  163.         Inc(Row);
  164.         GotoXY(1,Row);Write(' ',tNode^.Name);
  165.         tNode := tNode^.Next;
  166.       until (Row = 9) or (tNode = nil);
  167.  
  168.       tNode := DirList;
  169.  
  170.       Row := 1;
  171.       TerminateLoop := False;
  172.  
  173.       repeat
  174.         GotoXY(1,Row);TextAttr := OptionSelectedTextAttr;
  175.         Write(' ',tNode^.Name);ClrEol;
  176.         Keystroke := ReadKey;
  177.         GotoXY(1,Row);TextAttr := OptionNormTextAttr;Write(' ',tNode^.Name);ClrEol;
  178.  
  179.         case Keystroke of
  180.           ExtKey: case ReadKey of
  181.                     UpKey: begin
  182.                              if tNode^.Prev <> nil then
  183.                                begin
  184.                                  if Row = 1 then
  185.                                    begin
  186.                                      GotoXY(2,1);InsLine;
  187.                                      Write(tNode^.Prev^.Name);
  188.                                    end
  189.                                  else
  190.                                    Dec(Row);
  191.  
  192.                                  tNode := tNode^.Prev;
  193.                                end;
  194.                            end;
  195.                     DownKey: begin
  196.                                if tNode^.Next <> nil then
  197.                                  begin
  198.                                    if Row = 9 then
  199.                                      begin
  200.                                        GotoXY(1,1);DelLine;
  201.                                        GotoXY(2,9);Write(tNode^.Next^.Name);
  202.                                      end
  203.                                    else
  204.                                      Inc(Row);
  205.  
  206.                                    tNode := tNode^.Next;
  207.                                  end;
  208.                              end;
  209.                     PgDnKey: begin
  210.                                ScrollNode := tNode;
  211.  
  212.                                { move pointer to end of displayed list }
  213.                                if Row < 9 then
  214.                                  begin
  215.                                    for Ctr := Row+1 to 9 do
  216.                                      begin
  217.                                        ScrollNode := ScrollNode^.Next;
  218.                                      end;
  219.                                  end;
  220.  
  221.                                if ScrollNode^.Next <> nil then
  222.                                  begin
  223.                                    Ctr := 1;
  224.                                    while (Ctr <= 9) and (ScrollNode^.Next <> nil) do
  225.                                      begin
  226.                                        GotoXY(1,1);DelLine;
  227.                                        GotoXY(2,9);Write(ScrollNode^.Next^.Name);
  228.                                        tNode := tNode^.Next;
  229.                                        ScrollNode := ScrollNode^.Next;
  230.                                        Inc(Ctr);
  231.                                      end;
  232.                                  end;
  233.                              end;
  234.                     PgUpKey: begin
  235.                                ScrollNode := tNode;
  236.  
  237.                                { move pointer top of displayed list }
  238.                                if Row > 1 then
  239.                                  begin
  240.                                    for Ctr := Row-1 downto 1 do
  241.                                      begin
  242.                                        ScrollNode := ScrollNode^.Prev;
  243.                                      end;
  244.                                  end;
  245.  
  246.                                if ScrollNode^.Prev <> nil then
  247.                                  begin
  248.                                    Ctr := 1;
  249.                                    while (Ctr <= 9) and (ScrollNode^.Prev <> nil) do
  250.                                      begin
  251.                                        GotoXY(1,1);InsLine;
  252.                                        GotoXY(2,1);Write(ScrollNode^.Prev^.Name);
  253.                                        tNode := tNode^.Prev;
  254.                                        ScrollNode := ScrollNode^.Prev;
  255.                                        Inc(Ctr);
  256.                                      end;
  257.                                  end;
  258.                              end;
  259.  
  260.  
  261.                   end;
  262.            Enter: begin
  263.                     TerminateLoop := True;
  264.                     Signal := False;
  265.                   end;
  266.            Esc: begin
  267.                   TerminateLoop := True;
  268.                   Signal := True;
  269.                 end;
  270.         end;
  271.       until TerminateLoop;
  272.  
  273.       FileName := tNode^.Name;
  274.     end;
  275. end;
  276.  
  277. procedure DirObject.Sort;
  278. var
  279.   tNode1,tNode2: DirListType;
  280.   tName: FileNameStr;
  281.  
  282. begin
  283.   tNode1 := ListToSort;
  284.  
  285.   while tNode1 <> nil do
  286.     begin
  287.       tNode2 := tNode1^.Next;
  288.       while tNode2 <> nil do
  289.         begin
  290.           if tNode1^.Name > tNode2^.Name then
  291.             begin
  292.               tName := tNode1^.Name;
  293.               tNode1^.Name := tNode2^.Name;
  294.               tNode2^.Name := tName;
  295.             end;
  296.  
  297.           tNode2 := tNode2^.Next;
  298.         end;
  299.  
  300.       tNode1 := tNode1^.Next;
  301.     end;
  302. end;
  303.  
  304. procedure DirObject.Clear;
  305. var
  306.   tNode1: DirListType;
  307.   tNode2: DirListType;
  308.  
  309. begin
  310.   if DirList <> nil then
  311.     begin
  312.       tNode1 := DirList;
  313.       tNode2 := DirList^.Next;
  314.  
  315.       repeat
  316.         Dispose(tNode1);
  317.         tNode1 := tNode2;
  318.  
  319.         if tNode2 <> nil then
  320.           tNode2 := tNode2^.Next;
  321.       until tNode1 = nil
  322.     end;
  323. end;
  324.  
  325.  
  326.  
  327. end.
  328.